home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl67.lha / tcl6.7 / tclBasic.c < prev    next >
C/C++ Source or Header  |  1992-08-21  |  29KB  |  1,075 lines
  1. /* 
  2.  * tclBasic.c --
  3.  *
  4.  *    Contains the basic facilities for TCL command interpretation,
  5.  *    including interpreter creation and deletion, command creation
  6.  *    and deletion, and command parsing and execution.
  7.  *
  8.  * Copyright 1987-1992 Regents of the University of California
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appear in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #ifndef lint
  19. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclBasic.c,v 1.133 92/08/21 15:45:32 ouster Exp $ SPRITE (Berkeley)";
  20. #endif
  21.  
  22. #include "tclInt.h"
  23.  
  24. /*
  25.  * The following structure defines all of the commands in the Tcl core,
  26.  * and the C procedures that execute them.
  27.  */
  28.  
  29. typedef struct {
  30.     char *name;            /* Name of command. */
  31.     Tcl_CmdProc *proc;        /* Procedure that executes command. */
  32. } CmdInfo;
  33.  
  34. /*
  35.  * Built-in commands, and the procedures associated with them:
  36.  */
  37.  
  38. static CmdInfo builtInCmds[] = {
  39.     /*
  40.      * Commands in the generic core:
  41.      */
  42.  
  43.     {"append",        Tcl_AppendCmd},
  44.     {"array",        Tcl_ArrayCmd},
  45.     {"break",        Tcl_BreakCmd},
  46.     {"case",        Tcl_CaseCmd},
  47.     {"catch",        Tcl_CatchCmd},
  48.     {"concat",        Tcl_ConcatCmd},
  49.     {"continue",    Tcl_ContinueCmd},
  50.     {"error",        Tcl_ErrorCmd},
  51.     {"eval",        Tcl_EvalCmd},
  52.     {"expr",        Tcl_ExprCmd},
  53.     {"for",        Tcl_ForCmd},
  54.     {"foreach",        Tcl_ForeachCmd},
  55.     {"format",        Tcl_FormatCmd},
  56.     {"global",        Tcl_GlobalCmd},
  57.     {"if",        Tcl_IfCmd},
  58.     {"incr",        Tcl_IncrCmd},
  59.     {"info",        Tcl_InfoCmd},
  60.     {"join",        Tcl_JoinCmd},
  61.     {"lappend",        Tcl_LappendCmd},
  62.     {"lindex",        Tcl_LindexCmd},
  63.     {"linsert",        Tcl_LinsertCmd},
  64.     {"list",        Tcl_ListCmd},
  65.     {"llength",        Tcl_LlengthCmd},
  66.     {"lrange",        Tcl_LrangeCmd},
  67.     {"lreplace",    Tcl_LreplaceCmd},
  68.     {"lsearch",        Tcl_LsearchCmd},
  69.     {"lsort",        Tcl_LsortCmd},
  70.     {"proc",        Tcl_ProcCmd},
  71.     {"regexp",        Tcl_RegexpCmd},
  72.     {"regsub",        Tcl_RegsubCmd},
  73.     {"rename",        Tcl_RenameCmd},
  74.     {"return",        Tcl_ReturnCmd},
  75.     {"scan",        Tcl_ScanCmd},
  76.     {"set",        Tcl_SetCmd},
  77.     {"split",        Tcl_SplitCmd},
  78.     {"string",        Tcl_StringCmd},
  79.     {"trace",        Tcl_TraceCmd},
  80.     {"unset",        Tcl_UnsetCmd},
  81.     {"uplevel",        Tcl_UplevelCmd},
  82.     {"upvar",        Tcl_UpvarCmd},
  83.     {"while",        Tcl_WhileCmd},
  84.  
  85.     /*
  86.      * Commands in the UNIX core:
  87.      */
  88.  
  89. #ifndef TCL_GENERIC_ONLY
  90.     {"cd",        Tcl_CdCmd},
  91.     {"close",        Tcl_CloseCmd},
  92.     {"eof",        Tcl_EofCmd},
  93.     {"exec",        Tcl_ExecCmd},
  94.     {"exit",        Tcl_ExitCmd},
  95.     {"file",        Tcl_FileCmd},
  96.     {"flush",        Tcl_FlushCmd},
  97.     {"gets",        Tcl_GetsCmd},
  98.     {"glob",        Tcl_GlobCmd},
  99.     {"open",        Tcl_OpenCmd},
  100.     {"puts",        Tcl_PutsCmd},
  101.     {"pwd",        Tcl_PwdCmd},
  102.     {"read",        Tcl_ReadCmd},
  103.     {"seek",        Tcl_SeekCmd},
  104.     {"source",        Tcl_SourceCmd},
  105.     {"tell",        Tcl_TellCmd},
  106.     {"time",        Tcl_TimeCmd},
  107. #endif /* TCL_GENERIC_ONLY */
  108.     {NULL,        (Tcl_CmdProc *) NULL}
  109. };
  110.  
  111. /*
  112.  *----------------------------------------------------------------------
  113.  *
  114.  * Tcl_CreateInterp --
  115.  *
  116.  *    Create a new TCL command interpreter.
  117.  *
  118.  * Results:
  119.  *    The return value is a token for the interpreter, which may be
  120.  *    used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or
  121.  *    Tcl_DeleteInterp.
  122.  *
  123.  * Side effects:
  124.  *    The command interpreter is initialized with an empty variable
  125.  *    table and the built-in commands.
  126.  *
  127.  *----------------------------------------------------------------------
  128.  */
  129.  
  130. Tcl_Interp *
  131. Tcl_CreateInterp()
  132. {
  133.     register Interp *iPtr;
  134.     register Command *cmdPtr;
  135.     register CmdInfo *cmdInfoPtr;
  136.     int i;
  137.  
  138.     iPtr = (Interp *) ckalloc(sizeof(Interp));
  139.     iPtr->result = iPtr->resultSpace;
  140.     iPtr->freeProc = 0;
  141.     iPtr->errorLine = 0;
  142.     Tcl_InitHashTable(&iPtr->commandTable, TCL_STRING_KEYS);
  143.     Tcl_InitHashTable(&iPtr->globalTable, TCL_STRING_KEYS);
  144.     iPtr->numLevels = 0;
  145.     iPtr->framePtr = NULL;
  146.     iPtr->varFramePtr = NULL;
  147.     iPtr->activeTracePtr = NULL;
  148.     iPtr->numEvents = 0;
  149.     iPtr->events = NULL;
  150.     iPtr->curEvent = 0;
  151.     iPtr->curEventNum = 0;
  152.     iPtr->revPtr = NULL;
  153.     iPtr->historyFirst = NULL;
  154.     iPtr->revDisables = 1;
  155.     iPtr->evalFirst = iPtr->evalLast = NULL;
  156.     iPtr->appendResult = NULL;
  157.     iPtr->appendAvl = 0;
  158.     iPtr->appendUsed = 0;
  159.     iPtr->numFiles = 0;
  160.     iPtr->filePtrArray = NULL;
  161.     for (i = 0; i < NUM_REGEXPS; i++) {
  162.     iPtr->patterns[i] = NULL;
  163.     iPtr->patLengths[i] = -1;
  164.     iPtr->regexps[i] = NULL;
  165.     }
  166.     iPtr->cmdCount = 0;
  167.     iPtr->noEval = 0;
  168.     iPtr->scriptFile = NULL;
  169.     iPtr->flags = 0;
  170.     iPtr->tracePtr = NULL;
  171.     iPtr->resultSpace[0] = 0;
  172.  
  173.     /*
  174.      * Create the built-in commands.  Do it here, rather than calling
  175.      * Tcl_CreateCommand, because it's faster (there's no need to
  176.      * check for a pre-existing command by the same name).
  177.      */
  178.  
  179.     for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
  180.     int new;
  181.     Tcl_HashEntry *hPtr;
  182.  
  183.     hPtr = Tcl_CreateHashEntry(&iPtr->commandTable,
  184.         cmdInfoPtr->name, &new);
  185.     if (new) {
  186.         cmdPtr = (Command *) ckalloc(sizeof(Command));
  187.         cmdPtr->proc = cmdInfoPtr->proc;
  188.         cmdPtr->clientData = (ClientData) NULL;
  189.         cmdPtr->deleteProc = NULL;
  190.         Tcl_SetHashValue(hPtr, cmdPtr);
  191.     }
  192.     }
  193.  
  194. #ifndef TCL_GENERIC_ONLY
  195.     TclSetupEnv((Tcl_Interp *) iPtr);
  196. #endif
  197.  
  198.     return (Tcl_Interp *) iPtr;
  199. }
  200.  
  201. /*
  202.  *----------------------------------------------------------------------
  203.  *
  204.  * Tcl_DeleteInterp --
  205.  *
  206.  *    Delete an interpreter and free up all of the resources associated
  207.  *    with it.
  208.  *
  209.  * Results:
  210.  *    None.
  211.  *
  212.  * Side effects:
  213.  *    The interpreter is destroyed.  The caller should never again
  214.  *    use the interp token.
  215.  *
  216.  *----------------------------------------------------------------------
  217.  */
  218.  
  219. void
  220. Tcl_DeleteInterp(interp)
  221.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  222.                  * by a previous call to Tcl_CreateInterp). */
  223. {
  224.     Interp *iPtr = (Interp *) interp;
  225.     Tcl_HashEntry *hPtr;
  226.     Tcl_HashSearch search;
  227.     register Command *cmdPtr;
  228.     int i;
  229.  
  230.     /*
  231.      * If the interpreter is in use, delay the deletion until later.
  232.      */
  233.  
  234.     iPtr->flags |= DELETED;
  235.     if (iPtr->numLevels != 0) {
  236.     return;
  237.     }
  238.  
  239.     /*
  240.      * Free up any remaining resources associated with the
  241.      * interpreter.
  242.      */
  243.  
  244.     for (hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
  245.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  246.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  247.     if (cmdPtr->deleteProc != NULL) { 
  248.         (*cmdPtr->deleteProc)(cmdPtr->clientData);
  249.     }
  250.     ckfree((char *) cmdPtr);
  251.     }
  252.     Tcl_DeleteHashTable(&iPtr->commandTable);
  253.     TclDeleteVars(iPtr, &iPtr->globalTable);
  254.     if (iPtr->events != NULL) {
  255.     int i;
  256.  
  257.     for (i = 0; i < iPtr->numEvents; i++) {
  258.         ckfree(iPtr->events[i].command);
  259.     }
  260.     ckfree((char *) iPtr->events);
  261.     }
  262.     while (iPtr->revPtr != NULL) {
  263.     HistoryRev *nextPtr = iPtr->revPtr->nextPtr;
  264.  
  265.     ckfree((char *) iPtr->revPtr);
  266.     iPtr->revPtr = nextPtr;
  267.     }
  268.     if (iPtr->appendResult != NULL) {
  269.     ckfree(iPtr->appendResult);
  270.     }
  271. #ifndef TCL_GENERIC_ONLY
  272.     if (iPtr->numFiles > 0) {
  273.     for (i = 0; i < iPtr->numFiles; i++) {
  274.         OpenFile *filePtr;
  275.     
  276.         filePtr = iPtr->filePtrArray[i];
  277.         if (filePtr == NULL) {
  278.         continue;
  279.         }
  280.         if (i >= 3) {
  281.         fclose(filePtr->f);
  282.         if (filePtr->f2 != NULL) {
  283.             fclose(filePtr->f2);
  284.         }
  285.         if (filePtr->numPids > 0) {
  286.             Tcl_DetachPids(filePtr->numPids, filePtr->pidPtr);
  287.             ckfree((char *) filePtr->pidPtr);
  288.         }
  289.         }
  290.         ckfree((char *) filePtr);
  291.     }
  292.     ckfree((char *) iPtr->filePtrArray);
  293.     }
  294. #endif
  295.     for (i = 0; i < NUM_REGEXPS; i++) {
  296.     if (iPtr->patterns[i] == NULL) {
  297.         break;
  298.     }
  299.     ckfree(iPtr->patterns[i]);
  300.     ckfree((char *) iPtr->regexps[i]);
  301.     }
  302.     while (iPtr->tracePtr != NULL) {
  303.     Trace *nextPtr = iPtr->tracePtr->nextPtr;
  304.  
  305.     ckfree((char *) iPtr->tracePtr);
  306.     iPtr->tracePtr = nextPtr;
  307.     }
  308.     ckfree((char *) iPtr);
  309. }
  310.  
  311. /*
  312.  *----------------------------------------------------------------------
  313.  *
  314.  * Tcl_CreateCommand --
  315.  *
  316.  *    Define a new command in a command table.
  317.  *
  318.  * Results:
  319.  *    None.
  320.  *
  321.  * Side effects:
  322.  *    If a command named cmdName already exists for interp, it is
  323.  *    deleted.  In the future, when cmdName is seen as the name of
  324.  *    a command by Tcl_Eval, proc will be called.  When the command
  325.  *    is deleted from the table, deleteProc will be called.  See the
  326.  *    manual entry for details on the calling sequence.
  327.  *
  328.  *----------------------------------------------------------------------
  329.  */
  330.  
  331. void
  332. Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
  333.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  334.                  * by a previous call to Tcl_CreateInterp). */
  335.     char *cmdName;        /* Name of command. */
  336.     Tcl_CmdProc *proc;        /* Command procedure to associate with
  337.                  * cmdName. */
  338.     ClientData clientData;    /* Arbitrary one-word value to pass to proc. */
  339.     Tcl_CmdDeleteProc *deleteProc;
  340.                 /* If not NULL, gives a procedure to call when
  341.                  * this command is deleted. */
  342. {
  343.     Interp *iPtr = (Interp *) interp;
  344.     register Command *cmdPtr;
  345.     Tcl_HashEntry *hPtr;
  346.     int new;
  347.  
  348.     hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, cmdName, &new);
  349.     if (!new) {
  350.     /*
  351.      * Command already exists:  delete the old one.
  352.      */
  353.  
  354.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  355.     if (cmdPtr->deleteProc != NULL) {
  356.         (*cmdPtr->deleteProc)(cmdPtr->clientData);
  357.     }
  358.     } else {
  359.     cmdPtr = (Command *) ckalloc(sizeof(Command));
  360.     Tcl_SetHashValue(hPtr, cmdPtr);
  361.     }
  362.     cmdPtr->proc = proc;
  363.     cmdPtr->clientData = clientData;
  364.     cmdPtr->deleteProc = deleteProc;
  365. }
  366.  
  367. /*
  368.  *----------------------------------------------------------------------
  369.  *
  370.  * Tcl_DeleteCommand --
  371.  *
  372.  *    Remove the given command from the given interpreter.
  373.  *
  374.  * Results:
  375.  *    0 is returned if the command was deleted successfully.
  376.  *    -1 is returned if there didn't exist a command by that
  377.  *    name.
  378.  *
  379.  * Side effects:
  380.  *    CmdName will no longer be recognized as a valid command for
  381.  *    interp.
  382.  *
  383.  *----------------------------------------------------------------------
  384.  */
  385.  
  386. int
  387. Tcl_DeleteCommand(interp, cmdName)
  388.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  389.                  * by a previous call to Tcl_CreateInterp). */
  390.     char *cmdName;        /* Name of command to remove. */
  391. {
  392.     Interp *iPtr = (Interp *) interp;
  393.     Tcl_HashEntry *hPtr;
  394.     Command *cmdPtr;
  395.  
  396.     hPtr = Tcl_FindHashEntry(&iPtr->commandTable, cmdName);
  397.     if (hPtr == NULL) {
  398.     return -1;
  399.     }
  400.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  401.     if (cmdPtr->deleteProc != NULL) {
  402.     (*cmdPtr->deleteProc)(cmdPtr->clientData);
  403.     }
  404.     ckfree((char *) cmdPtr);
  405.     Tcl_DeleteHashEntry(hPtr);
  406.     return 0;
  407. }
  408.  
  409. /*
  410.  *-----------------------------------------------------------------
  411.  *
  412.  * Tcl_Eval --
  413.  *
  414.  *    Parse and execute a command in the Tcl language.
  415.  *
  416.  * Results:
  417.  *    The return value is one of the return codes defined in tcl.hd
  418.  *    (such as TCL_OK), and interp->result contains a string value
  419.  *    to supplement the return code.  The value of interp->result
  420.  *    will persist only until the next call to Tcl_Eval:  copy it or
  421.  *    lose it! *TermPtr is filled in with the character just after
  422.  *    the last one that was part of the command (usually a NULL
  423.  *    character or a closing bracket).
  424.  *
  425.  * Side effects:
  426.  *    Almost certainly;  depends on the command.
  427.  *
  428.  *-----------------------------------------------------------------
  429.  */
  430.  
  431. int
  432. Tcl_Eval(interp, cmd, flags, termPtr)
  433.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  434.                  * by a previous call to Tcl_CreateInterp). */
  435.     char *cmd;            /* Pointer to TCL command to interpret. */
  436.     int flags;            /* OR-ed combination of flags like
  437.                  * TCL_BRACKET_TERM and TCL_RECORD_BOUNDS. */
  438.     char **termPtr;        /* If non-NULL, fill in the address it points
  439.                  * to with the address of the char. just after
  440.                  * the last one that was part of cmd.  See
  441.                  * the man page for details on this. */
  442. {
  443.     /*
  444.      * The storage immediately below is used to generate a copy
  445.      * of the command, after all argument substitutions.  Pv will
  446.      * contain the argv values passed to the command procedure.
  447.      */
  448.  
  449. #   define NUM_CHARS 200
  450.     char copyStorage[NUM_CHARS];
  451.     ParseValue pv;
  452.     char *oldBuffer;
  453.  
  454.     /*
  455.      * This procedure generates an (argv, argc) array for the command,
  456.      * It starts out with stack-allocated space but uses dynamically-
  457.      * allocated storage to increase it if needed.
  458.      */
  459.  
  460. #   define NUM_ARGS 10
  461.     char *(argStorage[NUM_ARGS]);
  462.     char **argv = argStorage;
  463.     int argc;
  464.     int argSize = NUM_ARGS;
  465.  
  466.     register char *src;            /* Points to current character
  467.                      * in cmd. */
  468.     char termChar;            /* Return when this character is found
  469.                      * (either ']' or '\0').  Zero means
  470.                      * that newlines terminate commands. */
  471.     int result;                /* Return value. */
  472.     register Interp *iPtr = (Interp *) interp;
  473.     Tcl_HashEntry *hPtr;
  474.     Command *cmdPtr;
  475.     char *dummy;            /* Make termPtr point here if it was
  476.                      * originally NULL. */
  477.     char *cmdStart;            /* Points to first non-blank char. in
  478.                      * command (used in calling trace
  479.                      * procedures). */
  480.     char *ellipsis = "";        /* Used in setting errorInfo variable;
  481.                      * set to "..." to indicate that not
  482.                      * all of offending command is included
  483.                      * in errorInfo.  "" means that the
  484.                      * command is all there. */
  485.     register Trace *tracePtr;
  486.  
  487.     /*
  488.      * Initialize the result to an empty string and clear out any
  489.      * error information.  This makes sure that we return an empty
  490.      * result if there are no commands in the command string.
  491.      */
  492.  
  493.     Tcl_FreeResult((Tcl_Interp *) iPtr);
  494.     iPtr->result = iPtr->resultSpace;
  495.     iPtr->resultSpace[0] = 0;
  496.     result = TCL_OK;
  497.  
  498.     /*
  499.      * Check depth of nested calls to Tcl_Eval:  if this gets too large,
  500.      * it's probably because of an infinite loop somewhere.
  501.      */
  502.  
  503.     iPtr->numLevels++;
  504.     if (iPtr->numLevels > MAX_NESTING_DEPTH) {
  505.     iPtr->numLevels--;
  506.     iPtr->result =  "too many nested calls to Tcl_Eval (infinite loop?)";
  507.     return TCL_ERROR;
  508.     }
  509.  
  510.     /*
  511.      * Initialize the area in which command copies will be assembled.
  512.      */
  513.  
  514.     pv.buffer = copyStorage;
  515.     pv.end = copyStorage + NUM_CHARS - 1;
  516.     pv.expandProc = TclExpandParseValue;
  517.     pv.clientData = (ClientData) NULL;
  518.  
  519.     src = cmd;
  520.     if (flags & TCL_BRACKET_TERM) {
  521.     termChar = ']';
  522.     } else {
  523.     termChar = 0;
  524.     }
  525.     if (termPtr == NULL) {
  526.     termPtr = &dummy;
  527.     }
  528.     *termPtr = src;
  529.     cmdStart = src;
  530.  
  531.     /*
  532.      * There can be many sub-commands (separated by semi-colons or
  533.      * newlines) in one command string.  This outer loop iterates over
  534.      * individual commands.
  535.      */
  536.  
  537.     while (*src != termChar) {
  538.     iPtr->flags &= ~(ERR_IN_PROGRESS | ERROR_CODE_SET);
  539.  
  540.     /*
  541.      * Skim off leading white space and semi-colons, and skip
  542.      * comments.
  543.      */
  544.  
  545.     while (1) {
  546.         register char c = *src;
  547.  
  548.         if ((CHAR_TYPE(c) != TCL_SPACE) && (c != ';') && (c != '\n')) {
  549.         break;
  550.         }
  551.         src += 1;
  552.     }
  553.     if (*src == '#') {
  554.         for (src++; *src != 0; src++) {
  555.         if ((*src == '\n') && (src[-1] != '\\')) {
  556.             src++;
  557.             break;
  558.         }
  559.         }
  560.         continue;
  561.     }
  562.     cmdStart = src;
  563.  
  564.     /*
  565.      * Parse the words of the command, generating the argc and
  566.      * argv for the command procedure.  May have to call
  567.      * TclParseWords several times, expanding the argv array
  568.      * between calls.
  569.      */
  570.  
  571.     pv.next = oldBuffer = pv.buffer;
  572.     argc = 0;
  573.     while (1) {
  574.         int newArgs, maxArgs;
  575.         char **newArgv;
  576.         int i;
  577.  
  578.         /*
  579.          * Note:  the "- 2" below guarantees that we won't use the
  580.          * last two argv slots here.  One is for a NULL pointer to
  581.          * mark the end of the list, and the other is to leave room
  582.          * for inserting the command name "unknown" as the first
  583.          * argument (see below).
  584.          */
  585.  
  586.         maxArgs = argSize - argc - 2;
  587.         result = TclParseWords((Tcl_Interp *) iPtr, src, flags,
  588.             maxArgs, termPtr, &newArgs, &argv[argc], &pv);
  589.         src = *termPtr;
  590.         if (result != TCL_OK) {
  591.         ellipsis = "...";
  592.         goto done;
  593.         }
  594.  
  595.         /*
  596.          * Careful!  Buffer space may have gotten reallocated while
  597.          * parsing words.  If this happened, be sure to update all
  598.          * of the older argv pointers to refer to the new space.
  599.          */
  600.  
  601.         if (oldBuffer != pv.buffer) {
  602.         int i;
  603.  
  604.         for (i = 0; i < argc; i++) {
  605.             argv[i] = pv.buffer + (argv[i] - oldBuffer);
  606.         }
  607.         oldBuffer = pv.buffer;
  608.         }
  609.         argc += newArgs;
  610.         if (newArgs < maxArgs) {
  611.         argv[argc] = (char *) NULL;
  612.         break;
  613.         }
  614.  
  615.         /*
  616.          * Args didn't all fit in the current array.  Make it bigger.
  617.          */
  618.  
  619.         argSize *= 2;
  620.         newArgv = (char **)
  621.             ckalloc((unsigned) argSize * sizeof(char *));
  622.         for (i = 0; i < argc; i++) {
  623.         newArgv[i] = argv[i];
  624.         }
  625.         if (argv != argStorage) {
  626.         ckfree((char *) argv);
  627.         }
  628.         argv = newArgv;
  629.     }
  630.  
  631.     /*
  632.      * If this is an empty command (or if we're just parsing
  633.      * commands without evaluating them), then just skip to the
  634.      * next command.
  635.      */
  636.  
  637.     if ((argc == 0) || iPtr->noEval) {
  638.         continue;
  639.     }
  640.     argv[argc] = NULL;
  641.  
  642.     /*
  643.      * Save information for the history module, if needed.
  644.      */
  645.  
  646.     if (flags & TCL_RECORD_BOUNDS) {
  647.         iPtr->evalFirst = cmdStart;
  648.         iPtr->evalLast = src-1;
  649.     }
  650.  
  651.     /*
  652.      * Find the procedure to execute this command.  If there isn't
  653.      * one, then see if there is a command "unknown".  If so,
  654.      * invoke it instead, passing it the words of the original
  655.      * command as arguments.
  656.      */
  657.  
  658.     hPtr = Tcl_FindHashEntry(&iPtr->commandTable, argv[0]);
  659.     if (hPtr == NULL) {
  660.         int i;
  661.  
  662.         hPtr = Tcl_FindHashEntry(&iPtr->commandTable, "unknown");
  663.         if (hPtr == NULL) {
  664.         Tcl_ResetResult(interp);
  665.         Tcl_AppendResult(interp, "invalid command name: \"",
  666.             argv[0], "\"", (char *) NULL);
  667.         result = TCL_ERROR;
  668.         goto done;
  669.         }
  670.         for (i = argc; i >= 0; i--) {
  671.         argv[i+1] = argv[i];
  672.         }
  673.         argv[0] = "unknown";
  674.         argc++;
  675.     }
  676.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  677.  
  678.     /*
  679.      * Call trace procedures, if any.
  680.      */
  681.  
  682.     for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
  683.         tracePtr = tracePtr->nextPtr) {
  684.         char saved;
  685.  
  686.         if (tracePtr->level < iPtr->numLevels) {
  687.         continue;
  688.         }
  689.         saved = *src;
  690.         *src = 0;
  691.         (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
  692.             cmdStart, cmdPtr->proc, cmdPtr->clientData, argc, argv);
  693.         *src = saved;
  694.     }
  695.  
  696.     /*
  697.      * At long last, invoke the command procedure.  Reset the
  698.      * result to its default empty value first (it could have
  699.      * gotten changed by earlier commands in the same command
  700.      * string).
  701.      */
  702.  
  703.     iPtr->cmdCount++;
  704.     Tcl_FreeResult(iPtr);
  705.     iPtr->result = iPtr->resultSpace;
  706.     iPtr->resultSpace[0] = 0;
  707.     result = (*cmdPtr->proc)(cmdPtr->clientData, interp, argc, argv);
  708.     if (result != TCL_OK) {
  709.         break;
  710.     }
  711.     }
  712.  
  713.     /*
  714.      * Free up any extra resources that were allocated.
  715.      */
  716.  
  717.     done:
  718.     if (pv.buffer != copyStorage) {
  719.     ckfree((char *) pv.buffer);
  720.     }
  721.     if (argv != argStorage) {
  722.     ckfree((char *) argv);
  723.     }
  724.     iPtr->numLevels--;
  725.     if (iPtr->numLevels == 0) {
  726.     if (result == TCL_RETURN) {
  727.         result = TCL_OK;
  728.     }
  729.     if ((result != TCL_OK) && (result != TCL_ERROR)) {
  730.         Tcl_ResetResult(interp);
  731.         if (result == TCL_BREAK) {
  732.         iPtr->result = "invoked \"break\" outside of a loop";
  733.         } else if (result == TCL_CONTINUE) {
  734.         iPtr->result = "invoked \"continue\" outside of a loop";
  735.         } else {
  736.         iPtr->result = iPtr->resultSpace;
  737.         sprintf(iPtr->resultSpace, "command returned bad code: %d",
  738.             result);
  739.         }
  740.         result = TCL_ERROR;
  741.     }
  742.     if (iPtr->flags & DELETED) {
  743.         Tcl_DeleteInterp(interp);
  744.     }
  745.     }
  746.  
  747.     /*
  748.      * If an error occurred, record information about what was being
  749.      * executed when the error occurred.
  750.      */
  751.  
  752.     if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
  753.     int numChars;
  754.     register char *p;
  755.  
  756.     /*
  757.      * Compute the line number where the error occurred.
  758.      */
  759.  
  760.     iPtr->errorLine = 1;
  761.     for (p = cmd; p != cmdStart; p++) {
  762.         if (*p == '\n') {
  763.         iPtr->errorLine++;
  764.         }
  765.     }
  766.     for ( ; isspace(*p) || (*p == ';'); p++) {
  767.         if (*p == '\n') {
  768.         iPtr->errorLine++;
  769.         }
  770.     }
  771.  
  772.     /*
  773.      * Figure out how much of the command to print in the error
  774.      * message (up to a certain number of characters, or up to
  775.      * the first new-line).
  776.      */
  777.  
  778.     numChars = src - cmdStart;
  779.     if (numChars > (NUM_CHARS-50)) {
  780.         numChars = NUM_CHARS-50;
  781.         ellipsis = " ...";
  782.     }
  783.  
  784.     if (!(iPtr->flags & ERR_IN_PROGRESS)) {
  785.         sprintf(copyStorage, "\n    while executing\n\"%.*s%s\"",
  786.             numChars, cmdStart, ellipsis);
  787.     } else {
  788.         sprintf(copyStorage, "\n    invoked from within\n\"%.*s%s\"",
  789.             numChars, cmdStart, ellipsis);
  790.     }
  791.     Tcl_AddErrorInfo(interp, copyStorage);
  792.     iPtr->flags &= ~ERR_ALREADY_LOGGED;
  793.     } else {
  794.     iPtr->flags &= ~ERR_ALREADY_LOGGED;
  795.     }
  796.     return result;
  797. }
  798.  
  799. /*
  800.  *----------------------------------------------------------------------
  801.  *
  802.  * Tcl_CreateTrace --
  803.  *
  804.  *    Arrange for a procedure to be called to trace command execution.
  805.  *
  806.  * Results:
  807.  *    The return value is a token for the trace, which may be passed
  808.  *    to Tcl_DeleteTrace to eliminate the trace.
  809.  *
  810.  * Side effects:
  811.  *    From now on, proc will be called just before a command procedure
  812.  *    is called to execute a Tcl command.  Calls to proc will have the
  813.  *    following form:
  814.  *
  815.  *    void
  816.  *    proc(clientData, interp, level, command, cmdProc, cmdClientData,
  817.  *        argc, argv)
  818.  *        ClientData clientData;
  819.  *        Tcl_Interp *interp;
  820.  *        int level;
  821.  *        char *command;
  822.  *        int (*cmdProc)();
  823.  *        ClientData cmdClientData;
  824.  *        int argc;
  825.  *        char **argv;
  826.  *    {
  827.  *    }
  828.  *
  829.  *    The clientData and interp arguments to proc will be the same
  830.  *    as the corresponding arguments to this procedure.  Level gives
  831.  *    the nesting level of command interpretation for this interpreter
  832.  *    (0 corresponds to top level).  Command gives the ASCII text of
  833.  *    the raw command, cmdProc and cmdClientData give the procedure that
  834.  *    will be called to process the command and the ClientData value it
  835.  *    will receive, and argc and argv give the arguments to the
  836.  *    command, after any argument parsing and substitution.  Proc
  837.  *    does not return a value.
  838.  *
  839.  *----------------------------------------------------------------------
  840.  */
  841.  
  842. Tcl_Trace
  843. Tcl_CreateTrace(interp, level, proc, clientData)
  844.     Tcl_Interp *interp;        /* Interpreter in which to create the trace. */
  845.     int level;            /* Only call proc for commands at nesting level
  846.                  * <= level (1 => top level). */
  847.     Tcl_CmdTraceProc *proc;    /* Procedure to call before executing each
  848.                  * command. */
  849.     ClientData clientData;    /* Arbitrary one-word value to pass to proc. */
  850. {
  851.     register Trace *tracePtr;
  852.     register Interp *iPtr = (Interp *) interp;
  853.  
  854.     tracePtr = (Trace *) ckalloc(sizeof(Trace));
  855.     tracePtr->level = level;
  856.     tracePtr->proc = proc;
  857.     tracePtr->clientData = clientData;
  858.     tracePtr->nextPtr = iPtr->tracePtr;
  859.     iPtr->tracePtr = tracePtr;
  860.  
  861.     return (Tcl_Trace) tracePtr;
  862. }
  863.  
  864. /*
  865.  *----------------------------------------------------------------------
  866.  *
  867.  * Tcl_DeleteTrace --
  868.  *
  869.  *    Remove a trace.
  870.  *
  871.  * Results:
  872.  *    None.
  873.  *
  874.  * Side effects:
  875.  *    From now on there will be no more calls to the procedure given
  876.  *    in trace.
  877.  *
  878.  *----------------------------------------------------------------------
  879.  */
  880.  
  881. void
  882. Tcl_DeleteTrace(interp, trace)
  883.     Tcl_Interp *interp;        /* Interpreter that contains trace. */
  884.     Tcl_Trace trace;        /* Token for trace (returned previously by
  885.                  * Tcl_CreateTrace). */
  886. {
  887.     register Interp *iPtr = (Interp *) interp;
  888.     register Trace *tracePtr = (Trace *) trace;
  889.     register Trace *tracePtr2;
  890.  
  891.     if (iPtr->tracePtr == tracePtr) {
  892.     iPtr->tracePtr = tracePtr->nextPtr;
  893.     ckfree((char *) tracePtr);
  894.     } else {
  895.     for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
  896.         tracePtr2 = tracePtr2->nextPtr) {
  897.         if (tracePtr2->nextPtr == tracePtr) {
  898.         tracePtr2->nextPtr = tracePtr->nextPtr;
  899.         ckfree((char *) tracePtr);
  900.         return;
  901.         }
  902.     }
  903.     }
  904. }
  905.  
  906. /*
  907.  *----------------------------------------------------------------------
  908.  *
  909.  * Tcl_AddErrorInfo --
  910.  *
  911.  *    Add information to a message being accumulated that describes
  912.  *    the current error.
  913.  *
  914.  * Results:
  915.  *    None.
  916.  *
  917.  * Side effects:
  918.  *    The contents of message are added to the "errorInfo" variable.
  919.  *    If Tcl_Eval has been called since the current value of errorInfo
  920.  *    was set, errorInfo is cleared before adding the new message.
  921.  *
  922.  *----------------------------------------------------------------------
  923.  */
  924.  
  925. void
  926. Tcl_AddErrorInfo(interp, message)
  927.     Tcl_Interp *interp;        /* Interpreter to which error information
  928.                  * pertains. */
  929.     char *message;        /* Message to record. */
  930. {
  931.     register Interp *iPtr = (Interp *) interp;
  932.  
  933.     /*
  934.      * If an error is already being logged, then the new errorInfo
  935.      * is the concatenation of the old info and the new message.
  936.      * If this is the first piece of info for the error, then the
  937.      * new errorInfo is the concatenation of the message in
  938.      * interp->result and the new message.
  939.      */
  940.  
  941.     if (!(iPtr->flags & ERR_IN_PROGRESS)) {
  942.     Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
  943.         TCL_GLOBAL_ONLY);
  944.     iPtr->flags |= ERR_IN_PROGRESS;
  945.  
  946.     /*
  947.      * If the errorCode variable wasn't set by the code that generated
  948.      * the error, set it to "NONE".
  949.      */
  950.  
  951.     if (!(iPtr->flags & ERROR_CODE_SET)) {
  952.         (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE",
  953.             TCL_GLOBAL_ONLY);
  954.     }
  955.     }
  956.     Tcl_SetVar2(interp, "errorInfo", (char *) NULL, message,
  957.         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
  958. }
  959.  
  960. /*
  961.  *----------------------------------------------------------------------
  962.  *
  963.  * Tcl_VarEval --
  964.  *
  965.  *    Given a variable number of string arguments, concatenate them
  966.  *    all together and execute the result as a Tcl command.
  967.  *
  968.  * Results:
  969.  *    A standard Tcl return result.  An error message or other
  970.  *    result may be left in interp->result.
  971.  *
  972.  * Side effects:
  973.  *    Depends on what was done by the command.
  974.  *
  975.  *----------------------------------------------------------------------
  976.  */
  977.     /* VARARGS2 */ /* ARGSUSED */
  978. int
  979. #ifndef lint
  980. Tcl_VarEval(va_alist)
  981. #else
  982. Tcl_VarEval(iPtr, p, va_alist)
  983.     Tcl_Interp *iPtr;        /* Interpreter in which to execute command. */
  984.     char *p;            /* One or more strings to concatenate,
  985.                  * terminated with a NULL string. */
  986. #endif
  987.     va_dcl
  988. {
  989.     va_list argList;
  990. #define FIXED_SIZE 200
  991.     char fixedSpace[FIXED_SIZE+1];
  992.     int spaceAvl, spaceUsed, length;
  993.     char *string, *cmd;
  994.     Tcl_Interp *interp;
  995.     int result;
  996.  
  997.     /*
  998.      * Copy the strings one after the other into a single larger
  999.      * string.  Use stack-allocated space for small commands, but if
  1000.      * the commands gets too large than call ckalloc to create the
  1001.      * space.
  1002.      */
  1003.  
  1004.     va_start(argList);
  1005.     interp = va_arg(argList, Tcl_Interp *);
  1006.     spaceAvl = FIXED_SIZE;
  1007.     spaceUsed = 0;
  1008.     cmd = fixedSpace;
  1009.     while (1) {
  1010.     string = va_arg(argList, char *);
  1011.     if (string == NULL) {
  1012.         break;
  1013.     }
  1014.     length = strlen(string);
  1015.     if ((spaceUsed + length) > spaceAvl) {
  1016.         char *new;
  1017.  
  1018.         spaceAvl = spaceUsed + length;
  1019.         spaceAvl += spaceAvl/2;
  1020.         new = ckalloc((unsigned) spaceAvl);
  1021.         memcpy((VOID *) new, (VOID *) cmd, spaceUsed);
  1022.         if (cmd != fixedSpace) {
  1023.         ckfree(cmd);
  1024.         }
  1025.         cmd = new;
  1026.     }
  1027.     strcpy(cmd + spaceUsed, string);
  1028.     spaceUsed += length;
  1029.     }
  1030.     va_end(argList);
  1031.     cmd[spaceUsed] = '\0';
  1032.  
  1033.     result = Tcl_Eval(interp, cmd, 0, (char **) NULL);
  1034.     if (cmd != fixedSpace) {
  1035.     ckfree(cmd);
  1036.     }
  1037.     return result;
  1038. }
  1039.  
  1040. /*
  1041.  *----------------------------------------------------------------------
  1042.  *
  1043.  * Tcl_GlobalEval --
  1044.  *
  1045.  *    Evaluate a command at global level in an interpreter.
  1046.  *
  1047.  * Results:
  1048.  *    A standard Tcl result is returned, and interp->result is
  1049.  *    modified accordingly.
  1050.  *
  1051.  * Side effects:
  1052.  *    The command string is executed in interp, and the execution
  1053.  *    is carried out in the variable context of global level (no
  1054.  *    procedures active), just as if an "uplevel #0" command were
  1055.  *    being executed.
  1056.  *
  1057.  *----------------------------------------------------------------------
  1058.  */
  1059.  
  1060. int
  1061. Tcl_GlobalEval(interp, command)
  1062.     Tcl_Interp *interp;        /* Interpreter in which to evaluate command. */
  1063.     char *command;        /* Command to evaluate. */
  1064. {
  1065.     register Interp *iPtr = (Interp *) interp;
  1066.     int result;
  1067.     CallFrame *savedVarFramePtr;
  1068.  
  1069.     savedVarFramePtr = iPtr->varFramePtr;
  1070.     iPtr->varFramePtr = NULL;
  1071.     result = Tcl_Eval(interp, command, 0, (char **) NULL);
  1072.     iPtr->varFramePtr = savedVarFramePtr;
  1073.     return result;
  1074. }
  1075.